home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / utils / xbm-button.el.z / xbm-button.el
Encoding:
Text File  |  1998-05-21  |  18.3 KB  |  323 lines
  1. ;;; Create XBM text buttons under XEmacs (requires 19.12 or beyond)
  2. ;;; Copyright (C) 1995 Kyle E. Jones
  3. ;;;
  4. ;;; This program is free software; you can redistribute it and/or modify
  5. ;;; it under the terms of the GNU General Public License as published by
  6. ;;; the Free Software Foundation; either version 1, or (at your option)
  7. ;;; any later version.
  8. ;;;
  9. ;;; This program is distributed in the hope that it will be useful,
  10. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12. ;;; GNU General Public License for more details.
  13. ;;;
  14. ;;; A copy of the GNU General Public License can be obtained from this
  15. ;;; program's author (send electronic mail to kyle@uunet.uu.net) or from
  16. ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
  17. ;;; 02139, USA.
  18. ;;;
  19. ;;; Synched up with: Not in FSF.
  20. ;;;
  21. ;;; Send bug reports to kyle@wonderworks.com
  22.  
  23. ;;; The sole interface function is xbm-button-create.
  24.  
  25.  
  26. (provide 'xbm-button)
  27.  
  28. (defvar xbm-button-version "1.00"
  29.   "Version string for xbm-button.")
  30.  
  31. (defvar xbm-button-vertical-padding 3
  32.   "Number of pixels between the text and the top/bottom of the button.")
  33.  
  34. (defvar xbm-button-horizontal-padding 3
  35.   "Number of pixels between the text and the left/right edges of the button.")
  36.  
  37. (defvar xbm-button-font-pixel-lines
  38.   '(
  39. "000011000001111110000011110101111111000111111110111111110001111010011110011110111100001111011110111101111000001111000111101110000111000111110001111111000011111000011111110000111101011111111011110011101111000111011110111101110111101111011110111011111111000000000111000000000000000001110000000000011100000000011100000001100011011100000011100000000000000000000000000000000000000000000000000000000000000000100000000000000000000000000000000000000000000000000000000000011000001000111100011110000111000111110001110011111100111100011110001000000001100000111100000010100011110000110001000000010000001110000000100000010100000000000000000000000000000000001111000110111101100000000011010100000000000000000000000100111100100000100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
  40. "000011000000110011000110001100110001100011000110011000110011000110001100001100011000000110001100010000110000000111000111000111000010001100011000110001100110001100001100011001100011011011011001100001000110000010001100011000100011000100001100010011000111000000000011000000000000000000110000000000110100000000001100000001100011001100000001100000000000000000000000000000000000000000000000000000000000000001100000000000000000000000000000000000000000000000000000000000100100111001100110110011000111000111100010011011111101100110110011010000000001100011000010000010100110111001101111000000010000011001000010101000100010000000000000000000000000000000001100001100001100110000000011010100000000000000000000000101100110110000100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
  41. "000101100000110011001100000100110000110011000010011000010110000010001100001100011000000110001100100000110000000111000111000111100010011000001100110001101100000110001100011001100001010011001001100001000110000010001100011000100011101000001100010010001110000000000011000000000000000000110000000000110000000110001100000000000000001100000001100000000000000000000000000000000000000000000000000000000000000001100000000000000000000000000000000000000000000000000000000001100110011001100110110011001011000100000110011010001001100010110011011000000001100100111101001111110100100011001010000000111000011010000001110001100011000000000000000000000000000100001100001100001100110000000001010100000000000000000000000101100110010000100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
  42. "000101100000110011001100000100110000110011001000011001010110000010001100001100011000000110001101000000110000000101101011000101110010011000001100110001101100000110001100011001111000010011001001100001000011000100000110101101000001111000000110100000011100001111000011011000001110000110110000111001111100111100001101100011100111001101110001100111011001100011101100000111000111011000001101100111011001111011111011101110011110111011101111011101110111011110111011111101100110011000000110000011001011000111100110000000011000110100110011011000000001100101001101000101000110100011001010011000101000001100111010101001000001000000000000000000000000000100001100001100001100110011011010000000000000110000110000001100000110011000100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
  43. "001000110000111110001100000000110000110011111000011111000110000000001111111100011000000110001111100000110000000101101011000100111010011000001100110011001100000110001111100000111110000011000001100001000011000100000110101101000000111000000110100000011000001001100011101110111011011101110011101100110001100110001110110001100011001101100001100011101110110001110110011101110011101110111011100011111010001001100001100110001100010001100110001000110010001100010010011101100110011000001100001100010011000100110111110000011000111100011111000001100101101011011001000101000011110011010100110101101100011110010000100011000001100000000000000001111110000100001100001000001100010011011000000000000011100000011100001000001100001000100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
  44. "001111110000110001101100000000110000110011001000011001000110001111001100001100011000000110001101110000110000000101101011000100011110011000001100111110001101100110001100110000001111000011000001100001000001101000000110101101000001011100000011000000111000000111100011000110110000011000110011111100110001100110001100110001100011001111000001100011001100110001100110011000110011000110110001100011000011110001100001100110000110100000110111010000011100000110100000111001100110011000011000000011010011000000110110011000110000101110000011000011111101101011011010011111100000111001100101100101000100100111100000000011000001101111110000000000000000111111101100010000001100001000000000000000001110000000000111011000010000001100100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
  45. "010000011000110001101100000100110000110011000010011000000110000110001100001100011001100110001100110000110000100100110011000100001110011000001100110000001110010110001100110001000011000011000001100001000001101000000011000110000001001110000011000001110001011001100011000110110000011000110011000000110000111100001100110001100011001101100001100011001100110001100110011000110011000110110001100011000001111001100001100110000110100000110111010000011100000110100001110001100110011000100010110011011111101100110110011000110001000110110011000010011000001001101100001010000110101000001001100100000001100011100000000011000001100000000000000001111110000100001100001000001100010000000000000000000011100000011100010000000000000100100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
  46. "010000011000110001100110001100110001100011000110011000000011000110001100001100011001100110001100111000110001100100110011000100000110001100011000110000000110011100001100011101100011000011000001110011000000110000000011000110000010000110000011000011100011011011100011001110111011011101110011101100110001000000001100110001100011001100110001100011001100110001100110011101110011101110111011100011000010001001100001101110000011000000011001100000100110000011000011100100100100011001111110110011000011001100110110011000110001100110110010000000000001100100000010001010000110101000001001101000000001110011111000000001000001000000000000000000000000000100001100001100001100110011011000000001100000110110110000010000011000000110100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
  47. "111000111101111111000011111001111111000111111110111100000001111010011110011110111100111000011110011101111111101110110111101110000010000111110001111000000011111000011110011001011110000111100000111110000000110000000011000110000111001111000111100011111111001101110010111000001110000110111000111001111001111110011110111011110011011110111011110111101110111011110111000111000011011000001101100111100011110000110000110111000011000000011001100001110111000011000011111100011000111101111110011110000111100111100011110000110000111100011100000000000001100011111100001010000011110000010000110000000000111100110000000001100011000000000000000000000000000100001100001100001100110011011000000001100000000110000000010000011000000010100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
  48. "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001111000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000111111000000000000000011000000000000000000000000000000000000000000000011000000000001100000000000000000000000000000000000000000000000000000000000000010000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000100000000000000000000000000000000000000000100010000000000000000000000000000000001100001100001100110001000000000000100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
  49. "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000110000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001000011000000000000000011000000000000000000000000000000000000000000000011000000000001100000000000000000000000000000000000000000000000000000000000011100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010100000000000111111100000000000000001111000110111101100010000000000001000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
  50. "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000111110000000000000000110000000000000000000000000000000000000000000000111100000000011110000000000000000000000000000000000000000000000000000000000011000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
  51.    )
  52.   "List of strings representing pixel lines for the button font.")
  53.  
  54. (defvar xbm-button-font-line-indices
  55.   '(("A" 0 10)
  56.     ("B" 11 19)
  57.     ("C" 20 28)
  58.     ("D" 29 38)
  59.     ("E" 39 47)
  60.     ("F" 48 56)
  61.     ("G" 57 66)
  62.     ("H" 67 77)
  63.     ("I" 78 82)
  64.     ("J" 83 90)
  65.     ("K" 91 100)
  66.     ("L" 101 109)
  67.     ("M" 110 121)
  68.     ("N" 122 132)
  69.     ("O" 133 142)
  70.     ("P" 143 151)
  71.     ("Q" 152 162)
  72.     ("R" 163 172)
  73.     ("S" 173 180)
  74.     ("T" 181 189)
  75.     ("U" 190 199)
  76.     ("V" 200 210)
  77.     ("W" 211 224)
  78.     ("X" 225 234)
  79.     ("Y" 235 243)
  80.     ("Z" 244 252)
  81.     ("a" 253 260)
  82.     ("b" 261 269)
  83.     ("c" 270 276)
  84.     ("d" 277 285)
  85.     ("e" 286 292)
  86.     ("f" 293 298)
  87.     ("g" 299 306)
  88.     ("h" 307 315)
  89.     ("i" 316 320)
  90.     ("j" 321 324)
  91.     ("k" 325 333)
  92.     ("l" 334 338)
  93.     ("m" 339 351)
  94.     ("n" 352 360)
  95.     ("o" 361 368)
  96.     ("p" 369 377)
  97.     ("q" 378 386)
  98.     ("r" 387 393)
  99.     ("s" 394 399)
  100.     ("t" 400 405)
  101.     ("u" 406 414)
  102.     ("v" 415 423)
  103.     ("w" 424 436)
  104.     ("x" 437 444)
  105.     ("y" 445 453)
  106.     ("z" 454 460)
  107.     ("0" 461 467)
  108.     ("1" 468 472)
  109.     ("2" 473 479)
  110.     ("3" 480 486)
  111.     ("4" 487 493)
  112.     ("5" 494 500)
  113.     ("6" 501 507)
  114.     ("7" 508 514)
  115.     ("8" 515 521)
  116.     ("9" 522 528)
  117.     ("`" 529 531)
  118.     ("~" 532 538)
  119.     ("!" 539 541)
  120.     ("@" 542 552)
  121.     ("#" 553 560)
  122.     ("$" 561 567)
  123.     ("%" 568 580)
  124.     ("^" 581 586)
  125.     ("&" 587 597)
  126.     ("*" 598 603)
  127.     ("(" 604 608)
  128.     (")" 609 613)
  129.     ("-" 614 620)
  130.     ("_" 621 628)
  131.     ("=" 629 635)
  132.     ("+" 636 643)
  133.     ("[" 644 648)
  134.     ("{" 649 653)
  135.     ("]" 654 658)
  136.     ("}" 659 663)
  137.     (";" 664 666)
  138.     (":" 667 669)
  139.     ("'" 670 672)
  140.     ("\"" 673 676)
  141.     ("," 677 679)
  142.     ("<" 680 686)
  143.     ("." 687 689)
  144.     (">" 690 696)
  145.     ("/" 697 700)
  146.     ("?" 701 707)
  147.     ("\\" 708 713)
  148.     ("|" 714 715)
  149.     (" " 716 719))
  150.   "Indices into the xbm-button-font-pixel-lines strings for each character.
  151. Format is
  152.   (STR START END)
  153. STR contains the character.
  154. START is where the character's pixels start in each string of
  155.    xbm-button-font-pixel-lines (0 is the index of the first pixel).
  156. END is the index of the position after the last pixel of the character.")
  157.  
  158. (defun xbm-bit-lines-to-xbm-bits (&optional beg end)
  159.   "Convert lines of bits to a string of chars containing the bits,
  160. plus width and height information.  A list of the form
  161.    (WIDTH HEIGHT STRING)
  162. is returned.  WIDTH is set to be the length of the first line,
  163. ignoring the newline.  HEIGHT is the number of lines in the region.
  164.  
  165. BEG and END specify the region containing the bit lines.  Each
  166. line should contain only the characters '0' or '1' and be
  167. terminated by a newline."
  168.   (or beg (setq beg (point-min)))
  169.   (or end (setq end (point-max)))
  170.   (let (octet octet-count bit-count b char width height)
  171.     (save-excursion
  172.       (save-excursion
  173.     (set-buffer (setq b (get-buffer-create
  174.                  " xbm-button-bit-lines-to-xbm")))
  175.     (erase-buffer))
  176.       (goto-char beg)
  177.       (setq bit-count 0
  178.         height 0
  179.         width (- (save-excursion (end-of-line) (point)) (point))
  180.         octet 0)
  181.       (while (< (point) end)
  182.     (setq char (char-after (point)))
  183.     (cond ((= char ?0)
  184.            (setq bit-count (1+ bit-count)))
  185.           ((= char ?1)
  186.            ;; least significant bit of octet is leftmost pixel.
  187.            (setq octet (+ octet (expt 2 bit-count))
  188.              bit-count (1+ bit-count)))
  189.           ((= char ?\n)
  190.            (setq height (1+ height))))
  191.     ;; output octet whenever we have retrived 8 bits or when
  192.     ;; a newline is encountered.
  193.     (cond ((or (= bit-count 8) (= char ?\n))
  194.            (save-excursion
  195.          (set-buffer b)
  196.          (insert-char octet))
  197.            (setq bit-count 0
  198.              octet 0)))
  199.     (forward-char 1))
  200.       (set-buffer b)
  201.       ;; otput last octet if any bits collected.
  202.       (cond ((not (= bit-count 0))
  203.          (insert-char octet)))
  204.  
  205.       (list width height (buffer-substring nil nil b)) )))
  206.  
  207. ;;;###autoload
  208. (defun xbm-button-create (text border-thickness)
  209.   "Returns a list of XBM image instantiators for a button displaying TEXT.
  210. The list is of the form
  211.    (UP DOWN DISABLED)
  212. where UP, DOWN, and DISABLED are the up, down and disabled image
  213. instantiators for the button.
  214.  
  215. BORDER-THICKNESS specifies how many pixels should be used for the
  216. borders on the edges of the buttons.  It should be a positive integer,
  217. or 0 to mean no border."
  218.   (save-excursion
  219.     (set-buffer (get-buffer-create " xbm-button-create"))
  220.     (erase-buffer)
  221.     ;; create the correct number of lines for the pixels for the
  222.     ;; characters.
  223.     (insert-char ?\n (length xbm-button-font-pixel-lines))
  224.     (let ((i 0)
  225.       (str (make-string 1 0))
  226.       (lim (length text))
  227.       (bg-char ?0)
  228.       font-pixel-lines q)
  229.       ;; loop through text, adding the character pixels
  230.       (while (< i lim)
  231.     (aset str 0 (aref text i))
  232.     (if (null (setq q (assoc str xbm-button-font-line-indices)))
  233.         nil ; no pixel data for this character
  234.       (goto-char (point-min))
  235.       (setq font-pixel-lines xbm-button-font-pixel-lines)
  236.       (while font-pixel-lines
  237.         (end-of-line)
  238.         (if (not (bolp))
  239.         ;; Insert space before some of the characters.
  240.         ;; This isn't really correct for this font
  241.         ;; but doing it right is too hard.
  242.         ;; This isn't TeX after all.
  243.         (if (memq (aref str 0) '(?, ?. ?\" ?! ?| ?\' ?\`))
  244.             (insert-char bg-char 1))
  245.           ;; offset the start a bit from the left edge of the button
  246.           (insert-char bg-char xbm-button-horizontal-padding))
  247.         ;; insert the character pixels.
  248.         (insert (substring (car font-pixel-lines) (nth 1 q) (nth 2 q)))
  249.         (forward-line)
  250.         (setq font-pixel-lines (cdr font-pixel-lines))))
  251.     (setq i (1+ i)))
  252.       ;; now offset the text from the right edge of the button.
  253.       (goto-char (point-min))
  254.       (while (not (eobp))
  255.     (end-of-line)
  256.     (insert-char bg-char xbm-button-horizontal-padding)
  257.     (forward-line)))
  258.     (let ((fg-char ?1)
  259.       (bg-char ?0)
  260.       i len up down disabled)
  261.       ;; find the length of a pixel line.
  262.       (goto-char (point-min))
  263.       (end-of-line)
  264.       (setq len (- (point) (point-min)))
  265.       ;; offset text from the top of the button
  266.       (goto-char (point-min))
  267.       (setq i xbm-button-vertical-padding)
  268.       (while (> i 0)
  269.     (insert-char bg-char len)
  270.     (insert ?\n)
  271.     (setq i (1- i)))
  272.       ;; offset text from the bottom of the button
  273.       (goto-char (point-max))
  274.       (setq i xbm-button-vertical-padding)
  275.       (while (> i 0)
  276.     (insert-char bg-char len)
  277.     (insert ?\n)
  278.     (setq i (1- i)))
  279.       ;; add borders to the pixel lines
  280.       (goto-char (point-min))
  281.       (while (not (eobp))
  282.     (insert-char fg-char border-thickness)
  283.     (end-of-line)
  284.     (insert-char fg-char border-thickness)
  285.     (forward-line))
  286.       ;; add top and bottom border lines
  287.       (setq i border-thickness)
  288.       (goto-char (point-min))
  289.       (while (> i 0)
  290.     (insert-char fg-char (+ len (* 2 border-thickness)))
  291.     (insert ?\n)
  292.     (setq i (1- i)))
  293.       (setq i border-thickness)
  294.       (goto-char (point-max))
  295.       (while (> i 0)
  296.     (insert-char fg-char (+ len (* 2 border-thickness)))
  297.     (insert ?\n)
  298.     (setq i (1- i)))
  299.       ;; convert the pixel lines to octets of xbm bit data
  300.       (setq up (xbm-bit-lines-to-xbm-bits)
  301.         down up)
  302.       ;; stipple the foreground pixels for the disabled button.
  303.       (let ((str (make-string 1 0))
  304.         (bit 0)
  305.         lim line-start)
  306.     (aset str 0 fg-char)
  307.     (goto-char (point-min))
  308.     (while (not (eobp))
  309.       (setq lim (save-excursion (end-of-line) (point))
  310.         line-start (point))
  311.       (while (search-forward str lim t)
  312.         (if (= (% (- (point) line-start) 2) bit)
  313.         (subst-char-in-region (1- (point)) (point) fg-char bg-char t)))
  314.       (if (zerop bit)
  315.           (setq bit 1)
  316.         (setq bit 0))
  317.       (forward-line)))
  318.       (setq disabled (xbm-bit-lines-to-xbm-bits))
  319.  
  320.       (list (vector 'xbm ':data up)
  321.         (vector 'xbm ':data down)
  322.         (vector 'xbm ':data disabled)) )))
  323.